home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / makebin.com / RUNBIN.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-04-16  |  2.3 KB  |  68 lines
  1. {A program to test a BIN program in an enviornment that TD can handle}
  2. {RunBin  Copyright 1989  Michael Day   V1.01 as of 15 April 1989}
  3. {all rights reserved}
  4.  
  5. {$F+,R-}
  6. Program RunBin;
  7.  
  8. type TestArray = array[0..65500] of byte;
  9.      TestPtr = ^TestArray;
  10.  
  11. var TestData : pointer;
  12.     TestPrg : TestPtr;
  13.     WorkString : string;
  14.     StrPtr : pointer;
  15.     Fil : string;
  16.     f : file;
  17.     j,size,result : word;
  18.     s : string;
  19.  
  20. begin
  21.   GetMem(TestData,sizeof(TestArray)+16);     {grab some working space}
  22.   TestPrg := ptr(seg(TestData^)+1,0);   {force addr to segment boundry}
  23.   StrPtr := @WorkString[1];               {point to the working string}
  24.  
  25.   if ParamCount > 0 then fil := ParamStr(1)  {get the program name}
  26.   else
  27.   begin                                            {didn't give one, so}
  28.     write('Enter name of BIN program to test: ');  {try asking for it}
  29.     readln(fil);
  30.   end;
  31.   j := 0;
  32.   repeat inc(j) until (j > length(fil)) or (fil[j] = '.');  {if no ext}
  33.   if j > length(fil) then fil := fil+'.BIN';                {add one}
  34.  
  35.   writeln('Testing: ',fil);                {tell 'em what we are using}
  36.   writeln;
  37.   assign(f,fil);
  38.   reset(f,1);
  39.   size := filesize(f);                    {check if we can load it}
  40.   if size > sizeof(TestArray) then
  41.   begin
  42.     writeln('Error: File too big');
  43.     halt(1);
  44.   end;
  45.  
  46.   reset(f,1);
  47.   blockread(f,TestPrg^,size,result);      {now load the program}
  48.   close(f);
  49.   s := '';                                {initialize the work string}
  50.   repeat                       {simulate a call from the database prg}
  51.     WorkString := 'This is a string from the database simulator'+
  52.                   '          '+'          '+'          '+'          '+#0;
  53.     writeln('** Entering BIN program **');
  54.     inline($1E                 {push ds}
  55.            /$C5/$1E/StrPtr     {lds bx,Workstring}
  56.            /$FF/$1E/TestPrg    {far call to the BIN prg}
  57.            /$1F);              {pop ds}
  58.     writeln('** Returned from BIN program **'); {tell 'em we made it back}
  59.     writeln(WorkString);       {show 'em the returned string}
  60.  
  61.     repeat
  62.       write('Run again (Y/N)?');              {ask for a retry}
  63.       readln(s);
  64.     until ((upcase(s[1]) <> 'Y') or (upcase(s[1]) <> 'N')) and
  65.           (length(s) > 0);
  66.   until (upcase(s[1]) = 'N');
  67. end.
  68.